perm filename PTMOVF.FAI[MSS,LCS] blob sn#255978 filedate 1977-01-03 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		TITLE PTMOVF ********* JUN 8,74 *********
C00012 ENDMK
C⊗;
	TITLE PTMOVF; ********* JUN 8,74 *********
	INTERNAL LOOK,LOOKD,LOOKF,RCLEF,R4567
	ENTRY	GETPTS,MOVIT,EXTEN
DEFINE ERROR (MSG)
<	JSA 16,.ERROR
	JUMP [ASCIZ/MSG/
]
>

.ERROR:	0
	OUTSTR [ASCIZ/?
/]				;MAKE SURE HE CAN SEE HIS ERROR
	OUTSTR @(16)		;OUTPUT ERROR MESSAGE
	CALLI 1,12		;LET USER CONTI2UE
	JRA 16,1(16)

	CH←13

REGS:	BLOCK 20

;LOOK(<FILE>) FOR NO EXT., LOOKD() FOR .DAT, LOOKF() FOR .DMD

LOOKF:	0
	MOVSI 0,'DMD'
	JRST LOOK1
LOOKD:	0
	MOVSI 0,'DAT'
	JRST LOOK1
LOOK:	0
	MOVEI	0,0
LOOK1:	MOVEM	0,DIR+1
	MOVE	0,@(16)
	MOVEM 	0,FILNAM
	JSA 16, INTFIQ
	SETZM	DIR+2
	SETZM	DIR+3
	LOOKUP	CH,DIR
	TDZA	0,0
	MOVNI	0,1
	JRA 16,1(16)

INTFIQ:	0	;INITS DSK FOR INPUT
	MOVEI REGS
	BLT REGS+3
	INIT CH,17
	SIXBIT/DSK/
	0
	HALT .-3
;	ERROR <CAN'T INIT DSK!>

INTF4:	MOVE 0,FILNAM#
	MOVEM 0,FN#
	MOVE 1,[POINT 7,FN]
INTF3:	MOVE 2,[POINT 6,DIR]
	SETZM DIR
	MOVEI 3,5
INTF1:	ILDB 0,1
	CAIN 0," "
	JRST INTF2
	SUBI 0,40
	IDPB 0,2
	SOJG 3,INTF1
INTF2:	HRLZI REGS
	BLT 3
	JRA 16,0(16)

DIR:	BLOCK 4
	EXTERNAL .COMM.,XRN,KJY,PTR,POSI,AMOD,KNR,NNP

  K←15↔J←14↔ M←2↔ R2←5↔ X←6↔ L←4↔ R←7↔ A←11↔RY←3↔RZ←13↔JJ2←12
	DEFINE FIXX(N)
<	JUMPGE	N,.+5
	MOVNS	N
	FIX 	N,233000    
	MOVNS	N
	CAIA
	FIX	N,233000 >	; TO FIX IT LIKE 'IFIX' DOES.

; 	SUBROUTINE GETPTS
;	COMMON/KNR/N(500) /NNP/NP(500)
;	COMMON/XRN/RN(4000)  /KJY/ K,J
;	COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS
;	1/PTR/PWDS(250),ITEM,LL,I,IX
;	EQUIVALENCE (R4,RJQ(2)),(R5,RJQ(3)),(R11,RJQ(9))
;	1,(R6,RJQ(4))

GETPTS:	0		;CALL GETPTS(N)
	SETZ	J,	;	J=0
	SETZ	K,	;	K=0
	MOVE 	JJ2,POSI+=8
	MOVE	R2,.COMM.
;;	SETZ	X,
	MOVE	X,@(16)
	SOS	X
	MOVEI	M,PTR	;	DO 1 M=1,ITEM
	ADDI	M,(X)
G1:	AOJ	X,
	MOVE	L,(M)
	FIXX(L)
	MOVEI	R,XRN		;L=PWDS(M)
	ADDI	R,(L)		;IF(RTLINE(L))GO TO 1
	MOVE	1,1(R)		;RN(L+2)
	CAML	R2,[=5.0]
	JRST	GZ
	CAME	R2,1	
	JRST 	GX
GZ:	MOVE	A,.COMM.+7		;RY=RN(L+1)
	JUMPLE	A,G9			;F(R6.LE.0)GO TO 9
	CAME	A,(R)
	JRST	GX
;  CHECK CODE NUM
G9:	MOVE	A,2(R)		;IF(R6.NE.RY)GO TO 1
	CAMLE	A,.COMM.+6
	JRST	G2	;9	IF(OUTLIM(R4,R5,RN(L+3)))GO TO 2
	CAMGE	A,.COMM.+5	;R4
	JRST	G2

	SKIPG	JJ2
	MOVE	JJ2,X
	AOJ	J,
;  IN LIMITS?
;	MOVEI	A,XRN+=2498	;J=J+1
	MOVEI	A,KNR-1
	ADDI	A,(J)
	MOVEI	0,(L)
	AOJ	K,		;K=K+1
;	MOVEI	1,XRN+=2998
	MOVEI	1,NNP-1
	ADDI	1,(K)		;NP(K)=L
	MOVEM	0,(1)
	ADDI	0,3		;N(J)=L+3
	MOVEM	0,(A)
;  NP IS FOR USE IN JUSTIFY ROUTINE
G2:	MOVE	RY,(R)	;2	IF(RY.LT.4)GO TO 1
	CAMGE	RY,[=4.0]
	JRST	GX
	CAMLE	RY,[=7.0]
	JRST	GX		;IF(RY.GT.7)GO TO 1
;  TWO-ENDED ITEM?
	MOVE	RZ,-1(R)	;RZ=RN(L)
;  WD CNT
	CAMN	RY,[=4.0]	;GO TO(4,5,6,7),IFIX(RY)-3
	JRST	G4
	CAMN	RY,[=5.0]
	JRST	G5
	CAMN	RY,[=6.0]
	JRST	G6
	CAMG	RZ,[=4.0]	;4	IF(RZ.GT.2)GO TO 5
	JRST	G5		; THERE IS A TRILL WIGGLE
	JRST	GX		;GO TO 1   -- NO WIGGLE (P7≠0)
G4:	CAMG	RZ,[=2.0]	;7	IF(RZ.GT.3)GO TO 5
	JRST	GX
	JRST	G5		;GO TO 1
G6:	CAMGE	RZ,[=8.0]	;6	IF(RZ.LT.8)GO TO 8
	JRST	G8
;;	MOVEI	1,XRN		;IF(RN(L+10).LT.30)GO TO 8
;;	ADDI	1,(L)
;;	MOVE	1,11(1)
	MOVE	1,=9(R)
	CAMGE	1,[=30.0]
	JRST	G8
	MOVE	A,7(R)	  ; IF(OUTLIM(R4,R5,RN(L+8)))GO TO 8
	CAMLE	A,.COMM.+6
	JRST	G8
	CAMGE	A,.COMM.+5
	JRST	G8
	SKIPG	JJ2
	MOVE	JJ2,X
	AOJ	J,
;  IN LIMITS?
;	MOVEI	A,XRN+=2498	;J=J+1
	MOVEI	A,KNR-1
	ADDI	A,(J)
	MOVEI	0,(L)		;J=J+1
	ADDI	0,=8		;N(J)=L+8
	MOVEM	0,(A)
G8:	CAMGE	RZ,[=7.0]	;8	IF(RZ.LT.7)GO TO 5
	JRST 	G5
	MOVE	A,6(R)		;IF(RN(L+7))GO TO G8B
	JUMPL	A,G8B		; P7 IS NEG FOR TREMOLO
	MOVE	A,7(R)		;IF(RN(L+8).NE.0)GO TO G8B
	JUMPN	A,G8B
	CAMGE	RZ,[=8.0]
	JRST	G5		;IF(RZ.LT.8)GO TO G5
	MOVE	A,=9(R)		;IF(RN(L+10).EQ.0)GO TO G5
	JUMPE	A,G5		;PASSES NUMBER OVER BEAM.
G8B:	MOVE	A,8(R)
	CAMLE	A,.COMM.+6
	JRST	G5
	CAMGE	A,.COMM.+5	;R4
	JRST	G5

	SKIPG	JJ2
	MOVE	JJ2,X
	AOJ	J,		;J=J+1
;  IN LIMITS?
;	MOVEI	A,XRN+=2498	;J=J+1
	MOVEI	A,KNR-1
	ADDI	A,(J)
	MOVEI	0,(L)
	ADDI	0,=9		;IF(OUTLIM(R4,R5,RN(L+9)))GO TO 5
	MOVEM	0,(A)		;N(J)=L+9
G5:	MOVE	A,5(R)
	CAMLE	A,.COMM.+6
	JRST	GX
	CAMGE	A,.COMM.+5	;R4
	JRST	GX

	SKIPG	JJ2
	MOVE	JJ2,X
	AOJ	J,
;  IN LIMITS?
;|	MOVEI	A,XRN+=2498	;J=J+1
	MOVEI	A,KNR-1
	ADDI	A,(J)
	MOVEI	0,(L)  ;5	IF(OUTLIM(R4,R5,RN(L+6)))GO TO 1
	ADDI	0,6		;N(J)=L+6
	MOVEM	0,(A)
GX:	CAMGE	X,PTR+=250	;1	CONTINUE
	AOJA	M,G1
	MOVEM	JJ2,POSI+=8
	MOVEM	J,KJY+1
	MOVEM	K,KJY
	JRA	16,1(16)

;	SUBROUTINE MOVIT
;	COMMON /KNR/ N(500)
;	COMMON/XRN/RN(4000)  /KJY/ DONT,J
;	COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS
;	EQUIVALENCE (R4,RJQ(2)),(R5,RJQ(3)),(R9,RJQ(7))
;	1,(R6,RJQ(4)),(N,RN(2500)),(R8,RJQ(6))
MOVIT:	0		;RDIS=(R9-R8)/(R5-R4)
	MOVE	R,.COMM.+=10
	FSBR	R,.COMM.+=9
	MOVE	RY,.COMM.+6
	FSBR	RY,.COMM.+5
	FDVR	R,RY
;	MOVEI	L,XRN+=2499	;	DO 1 K=1,J
	MOVEI	L,KNR
	SETZ	K,
	MOVE	0,.COMM.+=10	; SET UP R9
M1:	MOVE	X,L	       ;	L=N(K)
	MOVE	A,(X)
	MOVEI 	R2,XRN		;RA=RN(L)
	ADDI	R2,(A)
	MOVEI	RZ,(R2)
	MOVE	R2,-1(R2)
	CAMGE	R2,.COMM.+5	;IF(OUTLIM(R4,R5,RA))GO TO 1
	JRST 	MX
	CAMLE	R2,.COMM.+6
	JRST	MX
	JUMPE	0,M2	;IF(R9.NE.0)RA=(RA-R4)*RDIS
	FSBR	R2,.COMM.+5
	FMPR	R2,R 
M2: 	FADR	R2,.COMM.+=9	;	RN(L)=R8+RA
	MOVEM	R2,-1(RZ)
MX:	AOJ	K,		;1	CONTINUE
	CAMGE	K,KJY+1
	AOJA	L,M1
	JRA	16,(16)

EXTEN:	0	;FUNCTION EXTEN(X)
	HRRM	16,.+2
	JSA	16,AMOD	;EXTEN=AMOD(X,1.)*10.
	JUMP 	@0
	JUMP	[=1.0]
	FMPR	[=10.0]
	JRA	16,1(16)


R4567:	0		;FUNCTION R4567(R)
	SETZ		;R4567=0
	MOVE 1,@(16)	;IF(R.LT.4)GO TO 1
	CAMGE 1,[=4.0]
	JRST .+2
	CAMG 1,[=7.0]	;IF(R.LE.7)RETURN
	SETO		;1  R4567=-1
	JRA 16,1(16)	;END

RCLEF:	0		;FUNCTION RCLEF(R)
	SETZ		;DIMENSION R(1)
	MOVE 1,[=3.0]	;RCLEF=0
	MOVEI 2,@(16)	;ADDR. OF R(1)
	CAME 1,1(2)	;IF(R(2).NE.3)RETURN
;  IS IT A CLEF?
	JRA 16,1(16)
	CAMLE 1,(2)	;IF(3.GE.R(1))RETURN
; IS THE WD CNT BIG ENOUGH
	JRA 16,1(16)
	CAMGE 1,5(2)	;IF(3.GT.R(6))RETURN
; FINDS ONLY 'REAL' CLEFS IN CODE #3
	SETO		;RCLEF=-1
	JRA 16,1(16)	;END

	END